home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / CorePackages / temp.tcl < prev    next >
Encoding:
Text File  |  2000-12-13  |  1.9 KB  |  67 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  # 
  4.  #  FILE: "temp.tcl"
  5.  #                                    created: 10/28/2000 {14:17:40 PM} 
  6.  #                                last update: 12/13/2000 {10:22:30 AM} 
  7.  #  Author: Vince Darley
  8.  #  
  9.  #  Handling of temporary files in AlphaTcl.  Used by ftpMenu, tex
  10.  #  mode.  Goal is to provide utilities useful for extension authors,
  11.  #  and to allow a future version of AlphaTcl to provide only limited
  12.  #  access to the filesystem (and hence use a 'Safe Tcl' model of
  13.  #  extensions, so a malicious extension cannot be written).
  14.  #  
  15.  #  Code under development; the API may change.
  16.  # ###################################################################
  17.  ##
  18.  
  19. namespace eval temp {}
  20.  
  21. proc temp::path {pkg args} {
  22.     global tcl_platform
  23.     if {$tcl_platform(platform) == "macintosh"} {
  24.     regsub -all "/" $args ":" args
  25.     } else {
  26.     regsub -all "~" $args "tilde" args
  27.     }
  28.     global PREFS
  29.     set name [eval [list file join $PREFS $pkg] $args]
  30.     file::ensureDirExists [file dirname $name]
  31.     return $name
  32. }
  33.  
  34. proc temp::isIn {pkg name} {
  35.     global PREFS
  36.     file::pathStartsWith $name [file join $PREFS $pkg]
  37. }
  38.  
  39. proc temp::unique {pkg name} {
  40.     global PREFS
  41.     set count 1
  42.     while {[file exists [set result [file join $PREFS $pkg $name$count]]]} {
  43.     incr count
  44.     }
  45.     file::ensureDirExists [file dirname $result]
  46.     return $result
  47. }
  48.  
  49. proc temp::cleanup {pkg} {
  50.     global PREFS
  51.     if {[file exists [file join $PREFS $pkg]]} {
  52.     catch {file delete -force [file join $PREFS $pkg]}
  53.     }
  54. }
  55.  
  56. proc temp::generate {pkg name code} {
  57.     global PREFS
  58.     set num 0
  59.     for {set i [expr [string length $code] - 1]} {$i >= 0} {incr i -1} {
  60.      scan [string index $code $i] "%c" char
  61.      incr num $char
  62.     }
  63.     set name [file join $PREFS $pkg $name.$num]
  64.     file::ensureDirExists [file dirname $name]
  65.     return $name
  66. }
  67.